home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 22 / CU Amiga Magazine's Super CD-ROM 22 (1998)(EMAP Images)(GB)[!][issue 1998-05].iso / PowerPC / Programming / PPCsiod / sources / siod.h < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-25  |  16.1 KB  |  445 lines

  1. /* Scheme In One Defun, but in C this time.
  2.  
  3.  *                        COPYRIGHT (c) 1989 BY                             *
  4.  *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
  5.  *        See the source file SLIB.C for more information.                  *
  6.  
  7. */
  8. #include <setjmp.h>
  9. #include <stdlib.h>
  10.  
  11. struct obj
  12. {char gc_mark;
  13.  char type;
  14.  union {struct {struct obj * car;
  15.         struct obj * cdr;} cons;
  16.     struct {double data;} flonum;
  17.     struct {long inte;} intnum;
  18.     struct {float real;
  19.                 float immag;} compnum;
  20.     struct {long num;
  21.                 unsigned long denom;} ratnum;
  22.     struct {char character;} charval;
  23.     struct {char *pname;
  24.         struct obj * vcell;} symbol;
  25.     struct {char *sname;
  26.         char small_string[4];} string;
  27.     struct {struct obj ** objvector;
  28.         long vector_size;} vector;
  29.     struct {struct obj * parent;
  30.         struct obj * bindings;} environment;
  31.     struct {long open_flag;
  32.         FILE * fp;} port;
  33.     struct {char *name;
  34.         struct obj * (*f)(void);} subr;
  35.     struct {char *name;
  36.         struct obj * (*f)(struct obj *);} subr1;
  37.     struct {char *name;
  38.         struct obj * (*f)(struct obj *,struct obj *);} subr2;
  39.     struct {char *name;
  40.         struct obj * (*f)(struct obj *,struct obj *,struct obj *);} subr3;
  41.     struct {char *name;
  42.         struct obj * (*f)(struct obj **,struct obj **);} msubr;
  43.     struct {struct obj *env;
  44.         struct obj *code;} closure;}
  45.  storage_as;};
  46.  
  47. #define PARENT(x) ((*x).storage_as.environment.parent)
  48. #define BINDINGS(x) ((*x).storage_as.environment.bindings)
  49. #define CODE(x) ((*x).storage_as.closure.code)
  50. #define DEFENV(x) ((*x).storage_as.closure.env)
  51. #define CAR(x) ((*x).storage_as.cons.car)
  52. #define CDR(x) ((*x).storage_as.cons.cdr)
  53. #define PNAME(x) ((*x).storage_as.symbol.pname)
  54. #define TCELL(x) ((*x).storage_as.symbol.vcell)
  55. #define VCELL(x) CAR(((*x).storage_as.symbol.vcell))
  56. #define PROPL(x) CDR(((*x).storage_as.symbol.vcell))
  57. #define MNAME(x) ((*x).storage_as.symbol.pname)
  58. #define EXPANDER(x) ((*x).storage_as.symbol.vcell)
  59. #define SNAME(x) ((*x).storage_as.string.sname)
  60. #define SSMALL(x) ((*x).storage_as.string.small_string)
  61. #define VECTOR(x) ((*x).storage_as.vector.objvector)
  62. #define VECSIZE(x) ((*x).storage_as.vector.vector_size)
  63. #define SUBRF(x) (*((*x).storage_as.subr.f))
  64. #define SUBR1F(x) (*((*x).storage_as.subr1.f))
  65. #define SUBR2F(x) (*((*x).storage_as.subr2.f))
  66. #define SUBR3F(x) (*((*x).storage_as.subr3.f))
  67. #define MSUBRF(x) (*((*x).storage_as.msubr.f))
  68. #define FLONM(x) ((*x).storage_as.flonum.data)
  69. #define RATNUM(x) ((*x).storage_as.ratnum.num)
  70. #define RATDEN(x) ((*x).storage_as.ratnum.denom)
  71. #define COMPRE(x) ((*x).storage_as.compnum.real)
  72. #define COMPIM(x) ((*x).storage_as.compnum.immag)
  73. #define INTNM(x) ((*x).storage_as.intnum.inte)
  74. #define CHARV(x) ((*x).storage_as.charval.character)
  75. #define PORTPTR(x) ((*x).storage_as.port.fp)
  76. #define PORTFLAG(x) ((*x).storage_as.port.open_flag)
  77.  
  78. #define NIL ((struct obj *)0)
  79. #define EQ(x,y) ((x) == (y))
  80. #define NEQ(x,y) ((x) != (y))
  81. #define NULLP(x) EQ(x,NIL)
  82. #define NNULLP(x) NEQ(x,NIL)
  83.  
  84. #define TYPE(x) (((x)==NIL) ? 0 : (*(x)).type)
  85.  
  86. #define TYPEP(x,y) (TYPE(x) == (y))
  87. #define NTYPEP(x,y) (TYPE(x) != (y))
  88.  
  89. #define tc_nil    0
  90. #define tc_cons   1
  91. #define tc_environment 2
  92. #define tc_symbol 3
  93. #define tc_subr_0 4
  94. #define tc_subr_1 5
  95. #define tc_subr_2 6
  96. #define tc_subr_3 7
  97. #define tc_lsubr  8
  98. #define tc_fsubr  9
  99. #define tc_msubr  10
  100. #define tc_closure 11
  101. #define tc_free_cell 12
  102. #define tc_string 13
  103. #define tc_char 14
  104. #define tc_rec 15
  105. #define tc_intnum 16
  106. #define tc_ratnum 17
  107. #define tc_flonum 18
  108. #define tc_compnum 19
  109. #define tc_port 20
  110. #define tc_fluidclosure 21
  111. #define tc_macro 22
  112. #define tc_vector 23
  113.  
  114. typedef struct obj* LISP;
  115.  
  116. #define MISPARP(x)  EQ(x,missing_parameter)
  117. #define NUMBERP(x)  (nump(x))
  118. #define PORTP(x)    TYPEP(x,tc_port)
  119. #define CONSP(x)    TYPEP(x,tc_cons)
  120. #define FLONUMP(x)  TYPEP(x,tc_flonum)
  121. #define INTNUMP(x)  TYPEP(x,tc_intnum)
  122. #define RATNUMP(x)  TYPEP(x,tc_ratnum)
  123. #define COMPNUMP(x) TYPEP(x,tc_compnum)
  124. #define CHARP(x)    TYPEP(x,tc_char)
  125. #define STRINGP(x)  TYPEP(x,tc_string)
  126. #define SYMBOLP(x)  TYPEP(x,tc_symbol)
  127. #define VECTORP(x)  TYPEP(x,tc_vector)
  128. #define ENVP(x)     TYPEP(x,tc_environment)
  129.  
  130. #define NMISPARP(x)  NEQ(x,missing_parameter)
  131. #define NNUMBERP(x)  (!(nump(x)))
  132. #define NPORTP(x)    NTYPEP(x,tc_port)
  133. #define NCONSP(x)    NTYPEP(x,tc_cons)
  134. #define NFLONUMP(x)  NTYPEP(x,tc_flonum)
  135. #define NINTNUMP(x)  NTYPEP(x,tc_intnum)
  136. #define NRATNUMP(x)  NTYPEP(x,tc_ratnum)
  137. #define NCOMPNUMP(x) NTYPEP(x,tc_compnum)
  138. #define NCHARP(x)    NTYPEP(x,tc_char)
  139. #define NSTRINGP(x)  NTYPEP(x,tc_string)
  140. #define NSYMBOLP(x)  NTYPEP(x,tc_symbol)
  141. #define NENVP(x)     NTYPEP(x,tc_environment)
  142. #define NVECTORP(x)  NTYPEP(x,tc_vector)
  143.  
  144. #define TKBUFFERN 1024
  145.  
  146. #define ERR_NSYM 1
  147. #define ERR_NINT 2
  148. #define ERR_NNUM 4
  149. #define ERR_IND_RAN 8
  150. #define ERR_NENV 16
  151. #define ERR_NPOR 32
  152. #define ERR_NPAI 64
  153. #define ERR_NCHA 128
  154. #define ERR_NPRO 256
  155. #define ERR_FIRST 512
  156. #define ERR_SECOND 1024
  157. #define ERR_THIRD 2048
  158. #define ERR_GEN 4096
  159. #define ERR_GEN_ARG 8192
  160. #define ERR_NSTR 16384
  161. #define ERR_NVEC 32768
  162. #define ERR_NFIL 65536
  163. #define ERR_MEM 131072
  164.  
  165. extern char *must_malloc(unsigned long);
  166.  
  167. extern LISP cons(LISP,LISP),envcons(LISP,LISP);
  168. extern LISP gen_intern(char *,long);
  169.  
  170. extern LISP environment_bindings(LISP),environment_parent(LISP);
  171. extern LISP envp(LISP),proc_env(LISP),make_environment(LISP,LISP);
  172. extern LISP proc_code(LISP);
  173.  
  174. extern LISP append(LISP),append_rec(LISP,LISP);
  175. extern LISP appendI(LISP),appendI_rec(LISP,LISP);
  176. extern LISP last_pair(LISP),list_ref(LISP,LISP),list_tail(LISP,LISP);
  177. extern LISP delete(LISP,LISP),delq(LISP,LISP);
  178.  
  179. extern LISP car(LISP), cdr(LISP), setcar(LISP,LISP);
  180. extern LISP setcdr(LISP,LISP),consp(LISP);
  181. extern LISP llist(LISP),dotlist(LISP),cxr(LISP,LISP),lenght(LISP);
  182. extern long leng(LISP);
  183.  
  184. extern LISP symcons(char *, LISP),rintern(char *), cintern(char *);
  185. extern LISP symbolp(LISP),macrop(LISP),gensym(LISP),symtoasc(LISP),asctosym(LISP);
  186. extern LISP proplist(LISP), getprop(LISP,LISP), putprop(LISP, LISP,LISP);
  187. extern LISP remprop(LISP, LISP),inspect(LISP);
  188.  
  189. extern double myruntime(void);
  190. extern LISP lruntime(),install(LISP,LISP),disinstall(LISP);
  191. extern LISP getnumer(LISP),getdenom(LISP),makerat(LISP,LISP);
  192. extern LISP makecomp(LISP,LISP),getreal(LISP),getimag(LISP);
  193. extern LISP flocons(double), atomp(LISP), procp(LISP);
  194. extern LISP procedurep(LISP),closurep(LISP);
  195. extern LISP torational(LISP),tofloat(LISP),tocomplex(LISP),complexp(LISP);
  196. extern LISP ltorational(LISP),ltofloat(LISP),ltocomplex(LISP);
  197. extern LISP intcons(long),ratcons(double,double),compcons(float,float);
  198. extern LISP floco(double),ratco(long,unsigned long),compco(float,float);
  199. extern double cal_gcd_double(double,double),myatan(double,double);
  200. extern LISP integerp(LISP),rationalp(LISP),floatp(LISP),numberp(LISP);
  201. extern LISP plus(LISP),ltimes(LISP),difference(LISP);
  202. extern LISP converti(LISP,short),plus2(LISP,LISP),minus2(LISP,LISP);
  203. extern LISP divide2(LISP,LISP),times2(LISP,LISP),realp(LISP);
  204. extern int nump(LISP);
  205. extern LISP quotient(LISP), lquotient(LISP,LISP), greaterp(LISP,LISP);
  206. extern LISP lessp(LISP,LISP), lmax(LISP), lmin(LISP), lsqrt(LISP), zerop(LISP);
  207. extern LISP gcd(LISP), lcm(LISP), lround(LISP), ltruncate(LISP), lltruncate(LISP);
  208. extern LISP negative(LISP), positive(LISP), even(LISP), odd(LISP);
  209. extern LISP add1(LISP), sub1(LISP), diverso(LISP,LISP), uguale(LISP,LISP);
  210. extern LISP greatereqp(LISP,LISP), lesseqp(LISP,LISP),demoivre(double,double,double);
  211. extern LISP lsin(LISP),lcos(LISP),ltan(LISP),lasin(LISP),latan(LISP,LISP),lacos(LISP);
  212. extern LISP remainder(LISP,LISP),expt(LISP,LISP),lexp(LISP),llog(LISP,LISP);
  213. extern LISP ceiling(LISP), lfloor(LISP), Labs(LISP),minus(LISP),modulo(LISP,LISP);
  214.  
  215. extern LISP eq(LISP,LISP),eql(LISP,LISP),equal(LISP,LISP);
  216. extern LISP floatp(LISP),transon(LISP),transoff();
  217. extern LISP assq(LISP,LISP),assoc(LISP,LISP),assv(LISP,LISP);
  218. extern LISP memq(LISP,LISP),member(LISP,LISP),memv(LISP,LISP);
  219. extern LISP vec_sort(LISP,LISP,LISP),listmerge(LISP,LISP);
  220. extern LISP lsort(LISP,LISP),mergesort(LISP);
  221. extern int do_test(LISP,LISP);
  222.  
  223. extern int checksym(char *);
  224. extern LISP leval(LISP,LISP);
  225. extern LISP fast_leval(LISP,LISP),std_leval(LISP,LISP);
  226. extern LISP lread(LISP),lleval(LISP,LISP),lprint(LISP,LISP);
  227. extern LISP lprin(LISP,LISP),lwritechar(LISP,LISP),lprintlenght(LISP,LISP),lwrite(LISP,LISP);
  228. extern LISP setfileposition(LISP,LISP,LISP),getfileposition(LISP);
  229. extern LISP writeln(LISP),lreadchar(LISP),lreadline(LISP),file_exist(LISP);
  230. extern LISP lprin1f(LISP,FILE*),ldisplayf(LISP,FILE*),f_getstr(FILE*);
  231. extern int flush_ws(FILE *,char *);
  232. extern int f_getc(FILE*);
  233. extern void f_ungetc(int, FILE *);
  234.  
  235. extern LISP subrcons(long,char *,LISP (*)());
  236. extern LISP closure(LISP,LISP);
  237. extern LISP rec_closure(LISP,LISP);
  238.  
  239. extern LISP makevector(LISP,LISP),vectorref(LISP,LISP),vectorset(LISP,LISP,LISP);
  240. extern LISP vectorlenght(LISP),vectorp(LISP),vectorcons(long,LISP);
  241. extern LISP vectortolist(LISP),listtovector(LISP),vectorm(LISP);
  242. extern LISP leval_catch(LISP,LISP),lthrow(LISP,LISP),vectorfill(LISP,LISP);
  243. extern FILE *get_cur_in(void),*get_cur_out(void);
  244.  
  245. extern LISP save_forms(LISP,LISP,LISP),symbolconc(LISP);
  246. extern LISP curr_input(void),curr_output(void);
  247. extern LISP with_input(LISP,LISP),with_output(LISP,LISP);
  248. extern LISP call_with_input(LISP,LISP),call_with_output(LISP,LISP);
  249. extern LISP leval_define(LISP,LISP),leval_lambda(LISP,LISP);
  250. extern LISP leval_named_lambda(LISP,LISP),leval_macro(LISP,LISP);
  251. extern LISP leval_if(LISP *,LISP *),leval_cond(LISP *,LISP *);
  252. extern LISP leval_case(LISP *,LISP *),leval_apply(LISP,LISP);
  253. extern LISP leval_applyif(LISP,LISP),leval_foreach(LISP,LISP);
  254. extern LISP leval_map(LISP,LISP),apply_proc(LISP,LISP,LISP);
  255. extern LISP leval_progn0(LISP *,LISP *),leval_when(LISP *,LISP *);
  256. extern LISP leval_while(LISP *,LISP *),leval_aut_fr_fi(LISP,LISP);
  257. extern void do_increment(LISP,LISP);
  258. extern LISP leval_do(LISP *,LISP *),env_prep(LISP);
  259.  
  260. extern LISP leval_progn(LISP *,LISP *),leval_setq(LISP,LISP);
  261. extern LISP leval_let(LISP *,LISP *),leval_let_env(LISP,LISP);
  262. extern LISP leval_let_star(LISP *,LISP *),leval_let_star_env(LISP,LISP);
  263. extern LISP leval_letrec(LISP *,LISP *),leval_letrec_env(LISP,LISP);
  264. extern void env_test(LISP);
  265. extern LISP leval_args(LISP,LISP),extend_env(LISP,LISP);
  266. extern LISP leval_args_env(LISP,LISP,LISP),assoc_args_env(LISP,LISP,LISP);
  267. extern LISP setvar(LISP,LISP,LISP),leval_quasiquote(LISP *,LISP *);
  268. extern LISP leval_quote(LISP,LISP),leval_and(LISP *,LISP *);
  269. extern LISP leval_or(LISP *,LISP *);
  270. extern LISP syntax_define(LISP),setv(LISP,LISP);
  271.  
  272. extern LISP fluid(LISP,LISP),fluid_boundp(LISP,LISP);
  273. extern LISP leval_fluidlet(LISP,LISP),leval_setfluid(LISP,LISP);
  274. extern LISP fluid_extend_env(LISP),fluidenvlookup(LISP,LISP);
  275. extern LISP leval_lambda_fluid(LISP,LISP),fluidclosure(LISP,LISP);
  276. extern LISP setfluidvar(LISP,LISP);
  277. extern LISP oblistfn(void),copy_list(LISP),reset(void),freesp(void);
  278. extern void scan_newspace(LISP),gc_stop_and_copy(void);
  279. extern LISP gc_relocate(LISP),get_newspace(void),gc_status(LISP);
  280. extern void gc_for_newcell(void),gc_mark_and_sweep(void);
  281. extern void gc_ms_stats_start(void), gc_ms_stats_end(void);
  282. extern void gc_mark(LISP ptr), gc_sweep(void),gc_sweep_array(void),mark_cons(LISP);
  283. extern void mark_protected_registers(void),mark_locations(LISP *,LISP *);
  284. extern void mark_locations_array(LISP [],long);
  285. extern LISP user_gc(LISP),breakpoint(LISP,LISP);
  286. extern LISP vload(char *,LISP),load(LISP,LISP),prerr(LISP);
  287. extern LISP leval_tenv(LISP,LISP),lerr(LISP),quit(void),nullp(LISP);
  288. extern LISP symbol_boundp(LISP,LISP),symbol_value(LISP,LISP);
  289. extern LISP envlookup(LISP,LISP),arglchk(LISP),reverse(LISP),reverseI(LISP);
  290. extern LISP newcell(long),laccess(LISP,LISP),unboundp(LISP,LISP),framelookup(LISP,LISP);
  291.  
  292. extern LISP strcons(long),charcons(long),charupcase(LISP),chardowncase(LISP);
  293. extern LISP string_append(LISP),string_to_symbol(LISP),makestring(LISP,LISP);
  294. extern LISP string_to_number(LISP,LISP,LISP),string_to_list(LISP),list_to_string(LISP);
  295. extern int rfs_getc(unsigned char **);
  296. extern void rfs_putc(unsigned char,unsigned char **);
  297. extern LISP read_from_string(LISP),string_to_un_symbol(LISP);
  298. extern LISP stringp(LISP),string_set(LISP,LISP,LISP);
  299. extern LISP charp(LISP),number_to_string(LISP,LISP),integer_to_string(LISP,LISP);
  300. extern LISP charcmp(LISP,LISP),chartoint(LISP),inttochar(LISP);
  301. extern LISP string_lenght(LISP),symbol_to_string(LISP);
  302. extern LISP string_copy(LISP);
  303. extern int strcmpCI(char *,char *);
  304. extern LISP string_cmpCI(LISP,LISP);
  305. extern LISP string_fill(LISP,LISP);
  306. extern LISP dos_call(LISP),random(LISP),randomize(LISP);
  307. extern LISP string_cmp(LISP,LISP),callasm(LISP);
  308. extern LISP string_ref(LISP,LISP),substring(LISP,LISP,LISP);
  309. extern LISP lreadr(FILE *),lreadparen(FILE *);
  310. extern LISP lreadtk(long),lreadf(FILE *),lflushinput(LISP);
  311. extern LISP readtl(FILE *);
  312. extern LISP error_han(void);
  313. extern LISP portcons(FILE *),open_port(char *,char *,int),close_port(LISP);
  314. extern LISP openport(LISP,LISP,LISP),portp(LISP),lflush(LISP);
  315. extern LISP input_portp(LISP),output_portp(LISP);
  316.  
  317. extern void gc_protect(LISP *);
  318. extern void gc_protect_n(LISP *,long);
  319. extern void gc_protect_sym(LISP *,char *);
  320. extern void scan_registers(void);
  321. extern void init_storage(void);
  322.  
  323. extern long no_interrupt(long);
  324.  
  325. extern void init_subr(char *,long,LISP (*)()),init_subrs(void),init_subr_fond(void);
  326. extern void repl_driver(void);
  327. extern void handle_sigfpe(int);
  328. extern void handle_sigabort(int);
  329. extern void handle_sigint(int);
  330. extern void err_ctrl_c(void);
  331. extern void fput_st(FILE *, char *);
  332. extern void put_st(char *);
  333. extern void grepl_puts(char *);
  334. extern void repl(void);
  335. extern void err(char *, LISP, int);
  336. extern void gc_fatal_error(void);
  337. extern void prinerr(int);
  338.  
  339. extern LISP eof_valp(LISP),scheme_reset(void),scheme_top_level(void);
  340. extern LISP reset_scheme_top_lev(void);
  341. extern double myruntime(void);
  342.  
  343. extern long cal_gcd(long,long);
  344. extern void process_cla(int, char **);
  345. extern int process_env(void);
  346. void print_welcome(void);
  347.  
  348. extern void print_hs_1(void),print_hs_2(void);
  349.  
  350. #define GETC_FCN(x) (f_getc(x))
  351. #define UNGETC_FCN(c,x) (f_ungetc(c,x))
  352.  
  353. struct catch_frame
  354. {LISP tag;
  355.  LISP retval;
  356.  jmp_buf cframe;
  357.  struct catch_frame *next;};
  358.  
  359. struct gc_protected
  360. {LISP *location;
  361.  long length;
  362.  struct gc_protected *next;};
  363.  
  364. extern LISP heap_1;
  365. extern LISP heap,heap_end,heap_org;
  366.  
  367. extern long heap_size;
  368. extern long full_set;
  369. extern long quiet;
  370. extern char *init_file;
  371. extern char tkbuffer[TKBUFFERN];
  372.  
  373. extern long gc_status_flag;
  374. extern long gc_cells_allocated;
  375. extern double gc_time_taken;
  376. extern LISP *stack_start_ptr;
  377. extern LISP freelist;
  378. extern FILE *transfile;
  379. extern jmp_buf errjmp;
  380. extern long errjmp_ok;
  381. extern long nointerrupt;
  382. extern long interrupt_differed;
  383.  
  384. extern LISP sym_alloc_strings;
  385. extern LISP sym_alloc_vectors;
  386. extern LISP sym_open_port;
  387. extern LISP sym_repl_mode;
  388. extern LISP sym_debug_mode;
  389. extern LISP sym_gc_mode;
  390. extern LISP sym_stdin;
  391. extern LISP sym_stdout;
  392. extern LISP sym_scheme_top_level;
  393. extern LISP sym_input_port;
  394. extern LISP sym_output_port;
  395. extern LISP val_scheme_top_level;
  396. extern LISP val_input_port;
  397. extern LISP val_output_port;
  398. extern LISP sym_standard_input;
  399. extern LISP sym_standard_output;
  400. extern LISP sym_fluid_environment;
  401. extern LISP sym_user_environment;
  402. extern LISP sym_initial_environment;
  403. extern LISP truth;
  404. extern LISP nil;
  405. extern LISP eof_val;
  406. extern LISP sym_the_non_printing;
  407. extern LISP sym_errobj;
  408. extern LISP sym_inspect;
  409. extern LISP sym_err_han;
  410. extern LISP sym_on_reset;
  411. extern LISP sym_err_string;
  412. extern LISP sym_progn;
  413. extern LISP sym_else;
  414. extern LISP sym_lambda;
  415. extern LISP sym_quote;
  416. extern LISP sym_dot;
  417. extern LISP unbound_marker;
  418. extern LISP missing_parameter;
  419. extern LISP cur_exp;
  420. extern LISP cur_env;
  421.  
  422. extern LISP *chararray;
  423. extern LISP *fixarray;
  424. extern LISP *obarray;
  425. extern LISP oblistvar;
  426. extern long fixarray_dim;
  427. extern long obarray_dim;
  428.  
  429. extern struct catch_frame *catch_framep;
  430. extern struct gc_protected *protected_registers;
  431.  
  432. extern jmp_buf save_regs_gc_mark;
  433.  
  434. extern double gc_rt;
  435. extern long gc_cells_collected;
  436.  
  437. #define NEWCELL(_into,_type)          \
  438. {if NULLP(freelist)                   \
  439.       gc_for_newcell();               \
  440.     _into = freelist;                 \
  441.     freelist = CDR(freelist);         \
  442.     ++gc_cells_allocated;             \
  443.  (*_into).gc_mark = 0;                \
  444.  (*_into).type = _type;}
  445.